home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 52
/
Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso
/
Aminet
/
gfx
/
conv
/
wbmp.lha
/
ILBM2WBMP.rexx
next >
Wrap
OS/2 REXX Batch file
|
2002-09-03
|
3KB
|
120 lines
/* ILBM -> Wireles Bitmap
$VER: Version 1.0 (03.09.02) */
IF ~SHOW('LIBRARIES','rexxsupport.library') THEN DO
IF ~ADDLIB('rexxsupport.library',10,-30,0) THEN DO
SAY 'Kann die <rexxsupport.library> nicht öffnen!'
EXIT(10)
END
END
Parse Arg OPTS
Parse Value OPTS with ILBM ' ' WBMP
IF Exists(ILBM)=0 Then Do
say "ILBM-file not found!"
Exit(0)
End
If ILBM="" | WBMP="" Then Do
Say '1b5b33326d'x||"ilbm2wbmp"||'1b5b33316d'x||" ilbm-file outfile"
Exit(0)
End
ILBMLaenge=SUBWORD(STATEF(ILBM),2,1)
If ILBMLaenge>65535 Then Do
"Say Picture to large"
Exit(0)
End
Call Open(ILBM,ILBM,R)
ILBM$=Readch(ILBM,ILBMLaenge)
If Substr(ILBM$,9,4)~="ILBM" Then Do
Say "not a ILBM-Picture"
Exit(0)
End
BMHD=Pos("BMHD",ILBM$,1)
ILBMWidth=C2D(Substr(ILBM$,BMHD+8,2))
If ILBMWidth>127 Then Do
say "Width to large"
Exit(0)
End
ILBMHeight=C2D(Substr(ILBM$,BMHD+10,2))
If ILBMHeight>127 Then Do
say "Height to large"
Exit(0)
End
ILBMDepth=C2D(Substr(ILBM$,BMHD+16,1))
If ILBMDepth>1 Then Do
say "to many Bitplanes"||D2C(10)||"only 2 colours (1 Bit Depth)"
Exit(0)
End
Compress=C2D(Substr(ILBM$,BMHD+18,1))
BODYAdr=Pos("BODY",ILBM$,1)+8
WBMPRowlen=ILBMWidth%8
IF ILBMWidth//8~=0 Then WBMPRowlen=WBMPRowlen+1
ILBMRowlen=WBMPRowlen
If (ILBMRowlen*8)//16~=0 Then ILBMRowlen=ILBMRowlen+1
WBMPBODYLen=WBMPRowlen*ILBMHeight
ILBMBODYLen=ILBMRowlen*ILBMHeight
ReadPos=seek(ILBM,BODYAdr-1,Begin)
say "Input-file "|| ILBM ||" [ILBM] "||ILBMWidth||"x"||ILBMHeight||"x1"
say "create wireless bitmap "||WBMP
If Compress=0 Then Do
Call Nocompress()
End
Else Do
Call Byterun()
End
C=Close(WBMP)
C=CLOSE(ILBM)
Exit(0)
NoCompress:
Call Open(WBMP,WBMP,W)
wr=Writech(WBMP,X2C(D2X(ILBMWidth,6)))
wr=Writech(WBMP,X2C(D2X(ILBMHeight,2)))
C=Close(WBMP)
Call Open(WBMP,WBMP,A)
RowDummy=Insert(D2C(0),"",1,WBMPRowlen-1,D2C(0))
Do D=1 To ILBMHeight
Row=Overlay(Readch(ILBM,WBMPRowlen),RowDummy,1,WBMPRowlen)
Wr=Writech(WBMP,Row)
ReadPos=seek(ILBM,Readpos+ILBMRowLen,Begin)
End
say "done"
Return(0)
Byterun:
Say "decode byterun..."
Call Open(WBMP,WBMP,W)
wr=Writech(WBMP,X2C(D2X(ILBMWidth,6)))
wr=Writech(WBMP,X2C(D2X(ILBMHeight,2)))
C=Close(WBMP)
Call Open(WBMP,WBMP,A)
ReadAdr=0 ; WriteAdr=1 ; Dummy=""
Endrow=ILBMHeight*ILBMDepth
Do Durchlauf = 1 To Endrow
RBZ=0 ; Row=""
Do Until(RBZ>=ILBMRowlen)
If RBZ<=ILBMRowlen Then Do
Compw=C2D(Substr(ILBM$,Bodyadr+ReadAdr,1))
If Compw>127 Then Do
WriteLen=257-Compw
Bytes=Insert("",Substr(ILBM$,Bodyadr+ReadAdr+1,1),0,Writelen-1,Substr(ILBM$,Bodyadr+ReadAdr+1,1))
WriteAdr=WriteAdr+WriteLen
RBZ=RBZ+WriteLen
ReadAdr=ReadAdr+2
Row=Row||Bytes
End
Else Do
WriteLen=Compw+1
Bytes=Substr(ILBM$,Bodyadr+ReadAdr+1,WriteLen)
WriteAdr=WriteAdr+WriteLen
RBZ=RBZ+WriteLen
ReadAdr=ReadAdr+WriteLen+1
Row=Row||Bytes
End
End
End
Writerow=Substr(Row,1,WBMPRowLen)
Wr=Writech(WBMP,writeRow)
End
say '0b'x||"done "
Return(0)